home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / checkers.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  4.9 KB  |  142 lines
  1. 1  'CHECKERS
  2. 2  KEY OFF:SCREEN 0,1,0:WIDTH 40:COLOR 15,1,9:CLS:DEFINT A-Z
  3. 4  GOSUB 4600
  4. 5  PRINT"KEY"STRING$(37,"THEN")"CLOSE
  5. 10  PRINT"OPEN"SPACE$(14)"CHECKERS"SPACE$(15)"OPEN
  6. 15  PRINT"SCREEN"STRING$(37,"THEN")"LOAD
  7. 20  PRINT:PRINT"THIS IS THE GAME OF CHECKERS.":PRINT
  8. 21  PRINT"THE COMPUTER IS GREEN, AND YOU ARE RED.
  9. 25  PRINT:PRINT"TO MOVE, MOVE THE CURSOR ON THE DEFSNGFROMDEFDBL
  10. 30  PRINT"SQUARE WITH THE NUMERIC KEY PAD.  PRESS
  11. 35  PRINT"<ENTER> TO ACCEPT YOUR MOVE.  THEN MOVE
  12. 40  PRINT"TO THE DEFSNGTODEFDBL SQUARE.  THE COORDINATES OF
  13. 45  PRINT"YOUR MOVE WILL BE SHOWN ON THE LEFT.
  14. 50  PRINT:PRINT"WHEN JUMPING, THE COMPUTER WILL SHOW
  15. 55  PRINT"DEFSNG& TODEFDBL SO YOU CAN CONTINUE JUMPING.  TO
  16. 60  PRINT"QUIT A SERIES OF JUMPS, PRESS THE <+>
  17. 65  PRINT"KEY.  TO START A MOVE OVER, PRESS "CHR$(17)"-"
  18. 67  PRINT"(BACKSPACE).  TO QUIT, PRESS <ESC>.
  19. 70  GOSUB 4650
  20. 80  DIM R(4),S(7,7),CP(11):G=-1:R(0)=-99
  21. 110  FOR X=0 TO 6 STEP 2:S(X,0)=1:S(X+1,1)=1:S(X,2)=1:S(X+1,5)=-1:S(X,6)=-1:S(X+1,7)=-1:NEXT
  22. 120  CP(0)=16:CP(1)=8:FOR X=2 TO 11:CP(X)=-1:NEXT
  23. 150  SCREEN 1,0:COLOR 1,1:OUT 985,49'MAKE FOREGROUND BRIGHTER
  24. 180  GOSUB 3000
  25. 190  LOCATE 25,1:PRINT"DO YOU WANT TO MOVE FIRST?_";
  26. 192  A$="":WHILE A$="":A$=INKEY$:WEND
  27. 200  IF A$="Y" OR A$="y" THEN LINE(0,192)-(319,199),0,BF:GOTO 1590
  28. 210  IF A$<>"N" AND A$<>"n" THEN 192
  29. 220  LINE(0,192)-(319,199),0,BF
  30. 230  FOR X=0 TO 7:FOR Y=0 TO 7:IF S(X,Y)>-1 THEN 350
  31. 310  IF S(X,Y)=-1 THEN FOR A=-1 TO 1 STEP 2:B=G:GOSUB 650:NEXT A
  32. 330  IF S(X,Y)=-2 THEN FOR A=-1 TO 1 STEP 2:FOR B=-1 TO 1 STEP 2:GOSUB 650:NEXT B,A
  33. 350  NEXT Y,X:GOSUB 3000:GOTO 1140
  34. 650  U=X+A:V=Y+B:IF U<0 OR U>7 OR V<0 OR V>7 THEN 870
  35. 740  IF S(U,V)=0 THEN GOSUB 910:GOTO 870
  36. 770  IF S(U,V)<0 THEN 870
  37. 790  U=U+A:V=V+B:IF U<0 OR V<0 OR U>7 OR V>7 THEN 870
  38. 850  IF S(U,V)=0 THEN GOSUB 910
  39. 870  RETURN
  40. 910  IF V=0 AND S(X,Y)=-1 THEN Q=Q+2
  41. 920  IF ABS(Y-V)=2 THEN Q=Q+5
  42. 960  IF Y=7 THEN Q=Q-2
  43. 980  IF Y=0 OR U=7 THEN Q=Q+1
  44. 1030  FOR C=-1 TO 1 STEP 2:IF U+C<0 OR U+C>0 OR V+G<0 THEN 1080
  45. 1035  IF S(U+C,V+G)<0 THEN Q=Q+1:GOTO 1080
  46. 1040  IF U-C<0 OR U-C>7 OR V-G>7 THEN 1080
  47. 1045  IF S(U+C,V+G)>0 AND (S(U-C,V-G)=0 OR (U-C=X AND V-G=Y)) THEN Q=Q-2
  48. 1080  NEXT C:IF Q>R(0) THEN R(0)=Q:R(1)=X:R(2)=Y:R(3)=U:R(4)=V
  49. 1100  Q=0:RETURN
  50. 1140  IF R(0)=-99 THEN 1880
  51. 1220  LINE(240,16)-(319,111),0,BF
  52. 1230  LOCATE 1,30:PRINT"MY FROM:":LOCATE 3,30:PRINT"FROM "CHR$(65+R(1))","CHR$(49+R(2)):LOCATE ,30:PRINT"  TO "CHR$(65+R(3))","CHR$(49+R(4)):R(0)=-99
  53. 1240  IF R(4)=0 THEN S(R(3),R(4))=-2:GOTO 1310
  54. 1250  S(R(3),R(4))=S(R(1),R(2))
  55. 1310  S(R(1),R(2))=0:IF ABS(R(1)-R(3))<>2 THEN GOSUB 3000:GOTO 1590
  56. 1330  S((R(1)+R(3))/2,(R(2)+R(4))/2)=0
  57. 1340  X=R(3):Y=R(4):IF S(X,Y)=-1 THEN B=-2:FOR A=-2 TO 2 STEP 4:GOSUB 1370:NEXT A
  58. 1350  IF S(X,Y)=-2 THEN FOR A=-2 TO 2 STEP 4:FOR B=-2 TO 2 STEP 4:GOSUB 1360:NEXT B,A
  59. 1360  IF R(0)<>-99 THEN LOCATE ,30:PRINT"  TO "CHR$(65+R(3))","CHR$(49+R(4)):R(0)=-99:GOTO 1240
  60. 1365  GOSUB 3000:GOTO 1590
  61. 1370  U=X+A:V=Y+B:IF U<0 OR U>7 OR V<0 OR V>7 THEN 1400
  62. 1380  IF S(U,V)=0 AND S(X+A/2,Y+B/2)>0 THEN GOSUB 910
  63. 1400  RETURN
  64. 1580  GOSUB 3000
  65. 1590  LOCATE 1,1:PRINT"YOUR MOVE:
  66. 1592  LINE(0,16)-(95,111),0,BF
  67. 1595  LOCATE 3,1:PRINT"FROM "CHR$(65+CO)","CHR$(49+DO);
  68. 1600  GOSUB 4000:E=C:H=D:IF E<0 OR H<0 THEN 1580
  69. 1602  LINE(0,192)-(319,199),0,BF
  70. 1610  X=E:Y=H:IF S(X,Y)<0 THEN BEEP:LOCATE 25,1:PRINT"PLAY YOUR OWN PIECES!";:GOTO 1595
  71. 1615  IF S(X,Y)=0 THEN BEEP:LOCATE 25,1:PRINT"THAT'S AN EMPTY SQUARE, TRY AGAIN!";:GOTO 1595
  72. 1620  LOCATE 4,1:PRINT"  TO "CHR$(65+C)","CHR$(49+D);:GOSUB 4000:A=C:B=D
  73. 1630  IF A<0 OR B<0 THEN SOUND 37,2:GOTO 1580
  74. 1670  X=A:Y=B
  75. 1680  IF S(X,Y)=0 AND ABS(A-E)<=2 AND ABS(A-E)=ABS(B-H) THEN 1700
  76. 1690  BEEP:GOTO 1620
  77. 1700  I=46
  78. 1750  S(A,B)=S(E,H):S(E,H)=0:IF ABS(E-A)<>2 THEN 1810
  79. 1800  S((E+A)/2,(H+B)/2)=0
  80. 1801  PRINT
  81. 1802  LOCATE ,1:PRINT"& TO    ";:GOSUB 4000:A1=C:B1=D:IF K$="+" THEN 1810
  82. 1803  IF K$=CHR$(8) THEN SOUND 37,2:GOTO 1580
  83. 1804  IF S(A1,B1)<>0 OR ABS(A1-A)<>2 OR ABS(B1-B)<>2 THEN 1802
  84. 1806  E=A:H=B:A=A1:B=B1:I=I+15:GOTO 1750
  85. 1810  IF B=7 THEN S(A,B)=2
  86. 1830  GOTO 230
  87. 1880  PLAY"T240C8D8E8G4E8G2
  88. 1890  LOCATE 25,16:PRINT"YOU WIN!";
  89. 1900  GOTO 9000
  90. 2000  SCREEN 1,0:COLOR 1,1:C=-1:OUT 985,49'MAKE FOREGROUND BRIGHTER
  91. 2010  FOR X=0 TO 7:FOR Y=0 TO 7:IF C THEN LINE(X*20+80,Y*20)-(X*20+99,Y*20+19),3,BF
  92. 2020  C=NOT C:NEXT:C=NOT C:NEXT:RETURN
  93. 3000  FOR Y=0 TO 7:FOR X=0 TO 7:GOSUB 3100:NEXT X,Y
  94. 3010  LOCATE 18,8:PRINT CHR$(24)"            <ENTER> ACCEPTS
  95. 3020  LOCATE 19,7:PRINT CHR$(27)" "CHR$(26)" MOVES     "CHR$(17)"-      CORRECTS
  96. 3030  LOCATE 20,8:PRINT CHR$(25)"            <ESC>   EXITS
  97. 3040  LOCATE 22,10:PRINT"<+> ENDS JUMP SERIES
  98. 3090  RETURN
  99. 3100  ON S(X,Y)+3 GOTO 3120,3130,3110,3150,3140
  100. 3110  LINE(X*16+100,116-Y*16)-(X*16+115,131-Y*16),((X XOR Y)AND 1)*3,BF:RETURN
  101. 3120  GOSUB 3130:LOCATE 16-Y-Y,X+X+14:PRINT"K";:RETURN
  102. 3130  CIRCLE(X*16+107,123-Y*16),7,3,,,1:PAINT(X*16+101,121-Y*16),1,3:RETURN
  103. 3140  GOSUB 3150:LOCATE 16-Y-Y,X+X+14:PRINT"K";:RETURN
  104. 3150  CIRCLE(X*16+107,123-Y*16),7,3,,,1:PAINT(X*16+101,121-Y*16),2,3:RETURN
  105. 4000  T=0
  106. 4010  C=CO:D=DO:PUT(C*16+104,120-D*16),CP
  107. 4030  GOSUB 4500
  108. 4040  CN=C:DN=D
  109. 4050  IF CO=CN AND DO=DN THEN 4100
  110. 4060  PUT(C*16+104,120-D*16),CP
  111. 4090  CO=CN:DO=DN:T=TN
  112. 4100  IF K$=CHR$(8) OR K$="+" THEN C=-1
  113. 4110  IF C<0 THEN PUT(CN*16+104,120-D*16),CP
  114. 4150  RETURN
  115. 4500  MF=0:K$=INKEY$:IF K$="" THEN 4500
  116. 4510  CT=C:DT=D
  117. 4520  IF K$=CHR$(13) OR K$=CHR$(8) OR K$="+" THEN RETURN
  118. 4525  IF K$=CHR$(27) THEN 4800
  119. 4530  IF K$=CHR$(0)+"H" OR K$="8" THEN D=(D+1) AND 7:MF=-1
  120. 4540  IF K$=CHR$(0)+"P" OR K$="2" THEN D=(D-1) AND 7:MF=-1
  121. 4550  IF K$=CHR$(0)+"K" OR K$="4" THEN C=(C-1) AND 7:MF=-1
  122. 4560  IF K$=CHR$(0)+"M" OR K$="6" THEN C=(C+1) AND 7:MF=-1
  123. 4570  IF MF THEN SOUND 32767,1:PUT(CT*16+104,120-DT*16),CP:PUT(C*16+104,120-D*16),CP:SOUND 37,0:LOCATE ,6:PRINT CHR$(65+C)","CHR$(49+D);
  124. 4590  GOTO 4500
  125. 4600   REM  TITLE PAGE ROUTINE.
  126. 4606  LOCATE 3,1:CT$="* CHECKERS *":GOSUB 4700
  127. 4614   PRINT:PRINT:PRINT:CT$="A VERY GOOD GAME OF CHECKERS":GOSUB 4700
  128. 4616  CT$="TO PLAY WITH YOUR IBM PC":GOSUB 4700
  129. 4650  LOCATE 24,1:PRINT"PRESS <SPACE> TO CONTINUE";
  130. 4660  LOCATE 25,1:PRINT"PRESS <ESC> TO EXIT";
  131. 4670  K$=INKEY$:IF K$="" THEN 4670
  132. 4680  IF K$=CHR$(27) THEN 10000
  133. 4690  IF K$<>" " THEN 4670 ELSE CLS:RETURN
  134. 4700  LOCATE ,20.5-LEN(CT$)\2
  135. 4710  PRINT CT$:RETURN
  136. 4800  LOCATE 25,1:PRINT"<SPACE> TO CONTINUE, <ESC> TO EXIT";
  137. 4810  K$=INKEY$:IF K$="" THEN 4810
  138. 4820  IF K$=CHR$(27) THEN RUN
  139. 4830  IF K$<>" " THEN 4830 ELSE CLS:K$="+":RETURN
  140. 9000  GOSUB 4650:RUN
  141. 10000  RUN"MENU
  142.